home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / tvtoys04.zip / SCROLL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-14  |  4KB  |  145 lines
  1. (***************************************************************************
  2.   ScrollingBar, a Scrollbar that updates its owner while dragging
  3.   PJB October 26, 1993, Internet mail to d91-pbr@nada.kth.se
  4.   Copyright 1993, All Rights Reserved. Portions Copyright Borland.
  5.   Free source, use at your own risk.
  6.   If modified, please state so if you pass this around.
  7.  
  8.   AAARGH! Lots of duplicated code due to Borland's use of the
  9.   private keyword.
  10.  
  11. ***************************************************************************)
  12. unit Scroll;
  13. {$B-,X+}
  14.  
  15. interface
  16.  
  17.   uses
  18.     App, Dialogs, Drivers, Objects, Views;
  19.  
  20.   type
  21.     PScrollingBar = ^TScrollingBar;
  22.     TScrollingBar =
  23.       object (TScrollbar)
  24.         procedure HandleEvent(var Event: TEvent); virtual;
  25.         function  GetPos: Integer;
  26.         function  GetSize: Integer;
  27.       end;
  28.  
  29.   procedure OnlyScrollingBars;
  30.  
  31.  
  32. (***************************************************************************
  33. ***************************************************************************)
  34. implementation
  35.  
  36.  
  37.   (*******************************************************************
  38.     Make all scrollbars work like scrolling bars
  39.     Modifies the VMT in the data segment
  40.   *******************************************************************)
  41.   procedure OnlyScrollingBars;
  42.     const
  43.       idxHev = 14;
  44.     type
  45.       LongArr = array [0..20] of Longint;
  46.   begin
  47.     LongArr(TypeOf(TScrollBar)^)[idxHev]:=LongArr(TypeOf(TScrollingBar)^)[idxHev];
  48.   end;
  49.  
  50.  
  51.     (*******************************************************************
  52.     *******************************************************************)
  53.  
  54.   (*******************************************************************
  55.     Thumb position
  56.   *******************************************************************)
  57.   function TScrollingBar.GetPos: Integer;
  58.     var
  59.       R: Integer;
  60.   begin
  61.     R := Max - Min;
  62.     if R = 0 then
  63.       GetPos := 1
  64.     else
  65.       GetPos := LongDiv(LongMul(Value-Min, GetSize-3)+R shr 1, R)+1;
  66.   end;
  67.  
  68.  
  69.   (*******************************************************************
  70.     Size of scrollbar
  71.   *******************************************************************)
  72.   function TScrollingBar.GetSize: Integer;
  73.     var
  74.       S: Integer;
  75.   begin
  76.     if Size.X = 1 then S := Size.Y else S := Size.X;
  77.     if S < 3 then GetSize := 3 else GetSize := S;
  78.   end;
  79.  
  80.  
  81.   (*******************************************************************
  82.     Handle mouse events differently
  83.   *******************************************************************)
  84.   procedure TScrollingBar.HandleEvent(var Event: TEvent);
  85.     var
  86.       Mouse    : TPoint;
  87.       Extent   : TRect;
  88.       I, S     : Integer;
  89.       OldValue : Integer;
  90.  
  91.     function GetPartCode:Integer;
  92.       var
  93.         Mark : Integer;
  94.     begin
  95.       GetPartCode := -1;
  96.       if Extent.Contains(Mouse) then
  97.       begin
  98.         if Size.X = 1 then
  99.           Mark := Mouse.Y
  100.         else
  101.           Mark := Mouse.X;
  102.  
  103.         if Mark = GetPos then
  104.           GetPartCode := sbIndicator;
  105.       end;
  106.     end;
  107.  
  108.   begin
  109.     if Event.What=evMouseDown then
  110.     begin
  111.       MakeLocal(Event.Where, Mouse);
  112.       GetExtent(Extent);
  113.       Extent.Grow(1, 1);
  114.       S := GetSize - 1;
  115.  
  116.       if GetPartCode = sbIndicator then
  117.       begin
  118.         Message(Owner, evBroadcast, cmScrollBarClicked, @Self);
  119.         OldValue:=Value;
  120.         repeat
  121.           MakeLocal(Event.Where, Mouse);
  122.  
  123.           if Extent.Contains(Mouse) then
  124.           begin
  125.             if Size.X = 1 then
  126.               I := Mouse.Y
  127.             else
  128.               I := Mouse.X;
  129.             if I <= 0 then I := 1;
  130.             if I >= S then I := S - 1;
  131.             SetValue(LongDiv(LongMul(I-1, Max-Min)+(S-2) shr 1, S-2)+Min);
  132.           end
  133.           else
  134.             SetValue(OldValue);
  135.         until not MouseEvent(Event, evMouseMove);
  136.         ClearEvent(Event);
  137.         Exit;
  138.       end;
  139.     end;
  140.  
  141.     inherited HandleEvent(Event);
  142.   end;
  143.  
  144.  
  145. end.